*  FILE NAME: CASHPHAR.PRG
*  BY: NURJADI PURNAMA
*  DATE: December 4, 1995
*  DESC:
*  CALLED BY:
*  DATA FILES:
ANOD=.T.
F9='DRUGS'
F10='DISPOS'
SELE 9
SET EXCLU OFF
USE &DR&F9 INDEX &DR&F9
SELE 10
SET EXCLU OFF
USE &DR&F10 INDE &DR&F10
SELE 2
SET EXCLU OFF
USE &DR&FILP ALIAS POO
do while anod
   set color to bg+/b
   @ 9,0 clea to 21,79
   @ 22,0 CLEA TO 24,45
   store space(5) to DRUGK,dispk
   store 0 to cntd,crd,DQNT

**
** Dickson - after the Dispos. code changed to new format
**         - to allow the user to search in 2 characters
**   STORE SPACE(1) TO DRUGIN,DISPIN
   STORE SPACE(2) TO DISPIN
**

*   do box2 with 9,0,"DELIVERY OF :","MEDICATIONS (DRUGS)","DISPOSABLE ITEMS",'w+','bg','w+','n',pl6,.f.,.t.
   do box2 with 9,0," ","DRUGS ITEMS","DISPOSABLE ITEMS",'gr+','b','gr+','n',pl6,.f.,.t.
   IF LASTKEY()=27
      ANOD=.F.
      LOOP
   ENDIF
   if PL6=1
      DRUGK=space(5)
      DO BOXlab WITH 12,0,'Enter Drugs Code :','DRUGK','gr+','B','gr+','N',5,.F.,.T.
*      DO BOXlab WITH 12,0,'Enter Drugs Code :','DRUGK','W+','RB','W+','N',5,.F.,.T.
      if DRUGK=SPACE(5)
         do boxi with 12,28,'Enter initial of Drug (trade name)  :','drugin','gr+','b','gr+','n',.f.,.t.
*         do boxi with 15,0,'Enter initial of Drug (trade name) to be dispensed :','drugin','w+','rb','W+','n',.f.,.t.
         DO CASH405
         if drugk=space(5)
            loop
         endif
      ENDIF
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 21,79
      SELE 9
      SEEK DRUGK
      IF .NOT. EOF()
         NMDR=DRUG_NAME
         TPDR=DRUG_TYPE
         SLUN=TRIM(SELL_UNIT)+' '+TRIM(DRUG_QANT)+' '+TRIM(DRUG_UNIT)
         SEUN=SELL_UNIT
****     EMDR=EMPLOYEE
****     IF TPPAT='0' .OR. TPPAT='9'
****        UNPR=EMP_PRICE
****     ELSE
****        UNPR=SALE_PRICE
****     ENDIF

         UNPR=SALE_PRICE
         UNNI=DRUG_UNIT
         QANT=DRUG_QANT
         HLDR=HEALTHLINE
         set colo to gr+/b
         @ 9,1 to 13,77 double
         @ 10,3 say 'Drug             : '+DRUGK+'   '+ALLTRIM(NMDR)+' '+ALLTRIM(TPDR)+'  '+SLUN
         if aeadeci
            @ 12,3 say 'Price ('+AEACURR+')      :'+TRANS(unPR,'###,###.##')+' Per '+alltrim(seun)
         else
            @ 12,3 say 'Price ('+AEACURR+')      :'+TRANS(unPR,'##,###,###')+' Per '+alltrim(seun)
         endif
         DO BOXN WITH 14,1,'Quantity         : ','DQNT','999','gr+','B','gr+','n','999','1',.F.,.f.
         if dqnt=1
            DO BOXT WITH 14,30,'Per '+SEUN,'gr+','B',.F.,.F.
         else
            DO BOXT WITH 14,30,'Per '+alltrim(SEUN)+'S','gr+','B',.F.,.F.
         endif
         TOTPR=UNPR*DQNT
**         DO BOXTD WITH 16,1,'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'#,###,###'),'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'##,###.##'),'gr+','b',.F.,.f.
**
**    Amended by dickson (30/12/98) - to allow the user to override the Total Price
**       - this is to cater for the CMPP plan which does not charge the patient
**         for certain type of drugs/disposable items used
**
         IF LEN(ALLTRIM(PRGNM)) > 0
            @ 16,03 SAY 'Total Price ('+AEACURR+'):'
            @ 16,23 GET  TOTPR PICT '#,###,###.##'
            READ
         ELSE
           DO BOXTD WITH 16,1,'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'#,###,###'),'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'##,###.##'),'gr+','b',.F.,.f.
         ENDIF
**
**     - End amended by dickson

         do box2 with 22,0,'Do You Want To :','CONFIRM','MODIFY','gr+','r','gr+','N',PL7,.F.,.t.
*         DO BOXT WITH 9,0,DRUGK+'   '+ALLTRIM(NMDR)+' '+ALLTRIM(TPDR)+'  '+SLUN,'W+','B',.F.,.F.
*         DO BOXTD WITH 11,0,'Price ('+AEACURR+') :'+TRANS(unPR,'##,###,###')+' Per '+alltrim(seun),'Price ('+AEACURR+') :'+TRANS(unPR,'###,###.##')+' Per '+alltrim(seun),'W+','b',.F.,.T.
*         DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
*         DO BOXN WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
*         if dqnt=1
*            DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
*         else
*            DO BOXT WITH 11,56,alltrim(SEUN)+'s','bg+','B',.F.,.F.
*         endif
*         TOTPR=UNPR*DQNT
*         DO BOXTD WITH 14,0,'TOTAL PRICE ('+AEACURR+') :'+TRANS(TOTPR,'#,###,###'),'TOTAL PRICE ('+AEACURR+') :'+TRANS(TOTPR,'##,###.##'),'W+','R',.F.,.T.
*         do box2 with 14,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
         IF PL7=2
            loop
         ELSE
            NDRUG=NDRUG+1
            IF TPPAT='0' .OR. TPPAT='9'
****           IF EMDR
               IF HLDR
                  HLRES=.T.
                  HPRIC=0
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=TOTPR
                  MPRIC=0
                  MSRES=.F.
               ENDIF
            ELSE
               IF HLDR .AND. HEALTH .AND. .NOT. HLVOID
                  HLRES=.T.
                  HPRIC=TOTPR
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                     HLRES=.F.
                     HPRIC=0
                     MPRIC=0
                     PPRIC=TOTPR
                     MSRES=.F.
               ENDIF
            ENDIF
            SELE 2
            DO CASHPHDR
            TOTL=TOTL+PPRIC
            PTOTL=PTOTL+PPRIC
         endif
      ELSE
         LOOP
      endif
*      DO BOXT WITH 19,46,'PHAR. PAYABLE ('+AEACURR+') :'+TRANS(PTOTL,'#,###,###'),'GR+','b',.F.,.T.
*       DO BOXT WITH 22,46,'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'#,###,###'),'GR+','b',.F.,.T.

      DO BOXTD WITH 19,46,'PHAR. PAYABLE ('+AEACURR+') :'+TRANS(PTOTL,'#,###,###'),'PHAR. PAYABLE ('+AEACURR+') :'+TRANS(PTOTL,'##,###.##'),'GR+','B',.F.,.T.
      DO BOXTD WITH 22,46,'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'#,###,###'),'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'##,###.##'),'GR+','B',.F.,.T.

   else

      DispK=space(5)
      DO BOXlab WITH 12,0,'Enter Disposable Code :','DispK','gr+','B','gr+','N',5,.F.,.T.
      if Dispk=SPACE(5)
**
**    dickson - 17/4/99 
**         do boxi with 12,33,'Enter initial of Disposable item :','dispin','gr+','b','gr+','n',.f.,.t.
         do boxo with 12,33,'Enter initial of Disposable item :','dispin','gr+','b','gr+','n',2,.f.,.t.
**

         DO CASH406
         if dispk=space(5)
            loop
         endif
      endif
      SET COLOR TO BG+/B
      @ 9,0 CLEA TO 20,79
      SELE 10
      SEEK DISPK
      IF .NOT. EOF()
         NMDS=DISP_NAME
         TPDS=DISP_TYPE
         SLUN=TRIM(SELL_UNIT)+' '+TRIM(DISP_QANT)+' '+TRIM(DISP_UNIT)
         SEUN=SELL_UNIT
         UNPS=SALE_PRICE
         UNNI=DISP_UNIT
         QANT=DISP_QANT
         HLDS=HEALTHLINE
         set colo to gr+/b
         @ 9, 1 to 13,77 double
         @ 10,3 say 'Disposable       : '+DISPK+'   '+ALLTRIM(NMDS)+' '+ALLTRIM(TPDS)+'  '+SLUN
         if aeadeci
            @ 12,3 say 'Price ('+AEACURR+')      : '+TRANS(UNPS,'##,###.##')+' Per '+alltrim(seun)
         else
            @ 12,3 say 'Price ('+AEACURR+')      : '+TRANS(UNPS,'#,###,###')+' Per '+alltrim(seun)
         endif
         DO BOXT WITH 14,30,'Per '+SEUN,'gr+','B',.F.,.F.
         DO BOXN WITH 14,1,'Quantity         : ','DQNT','999','Gr+','B','gr+','N','999','1',.F.,.f.
         TOTPR=UNPS*DQNT

**
**    Amended by dickson (30/12/98) - to allow the user to override the Total Price
**       - this is to cater for the CMPP plan which does not charge the patient
**         for certain type of drugs/disposable items used
**
**         DO BOXTD WITH 16,1,'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'#,###,###'),'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'##,###.##'),'gr+','b',.F.,.f.
         IF LEN(ALLTRIM(PRGNM)) > 0
            @ 16,03 SAY 'Total Price ('+AEACURR+'):'
            @ 16,23 GET  TOTPR PICT '#,###,###.##'
            READ
         ELSE
           DO BOXTD WITH 16,1,'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'#,###,###'),'Total Price ('+AEACURR+'):'+TRANS(TOTPR,'##,###.##'),'gr+','b',.F.,.f.
         ENDIF
**
**     - End amended by dickson

         do box2 with 22,0,'Do You Want To :','CONFIRM','MODIFY','gr+','r','gr+','N',PL7,.F.,.t.

*         DO BOXT WITH 9,0,DISPK+'   '+ALLTRIM(NMDS)+' '+ALLTRIM(TPDS)+'  '+SLUN,'W+','B',.F.,.F.
*         DO BOXTD WITH 11,0,'Price : ('+AEACURR+') '+TRANS(UNPS,'#,###,###')+' Per '+alltrim(seun),'Price : ('+AEACURR+') '+TRANS(UNPS,'##,###.##')+' Per '+alltrim(seun),'bg+','b',.F.,.T.
*         DO BOXT WITH 11,56,SEUN,'bg+','B',.F.,.F.
*         DO BOXN WITH 11,39,'Quantity : ','DQNT','999','BG+','B','W+','N','999','1',.F.,.F.
*         TOTPR=UNPS*DQNT
*         DO BOXTD WITH 14,0,'TOTAL PRICE ('+AEACURR+') :'+TRANS(TOTPR,'#,###,###'),'TOTAL PRICE ('+AEACURR+') :'+TRANS(TOTPR,'##,###.##'),'w+','r',.F.,.T.
*         do box2 with 22,40,'Do You Want To :','CONFIRM','MODIFY','gr+','r','W+','N',PL7,.F.,.t.
         IF PL7=2
            loop
         ELSE
            NDISP=NDISP+1

            IF TPPAT='0' .OR. TPPAT='9'
****           IF EMDS
               IF HLDS
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                  HLRES=.F.
                  HPRIC=0
                  PPRIC=TOTPR
                  MPRIC=0
                  MSRES=.F.
               ENDIF
            ELSE
               IF HLDS .AND. HEALTH .AND. .NOT. HLVOID
                  HLRES=.T.
                  HPRIC=TOTPR
                  PPRIC=0
                  MPRIC=0
                  MSRES=.F.
               ELSE
                     HLRES=.F.
                     HPRIC=0
                     PPRIC=TOTPR
                     MPRIC=0
                     MSRES=.F.
               ENDIF
            ENDIF
            SELE 2
            DO CASHPHDS
            TOTL=TOTL+PPRIC
            PTOTL=PTOTL+PPRIC
         endif
      ELSE
         LOOP
      endif
*      DO BOXT WITH 19,46,'PHAR. PAYABLE ('+AEACURR+') :'+TRANS(PTOTL,'#,###,###'),'GR+','B',.F.,.T.
*      DO BOXT WITH 22,46,'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'#,###,###'),'GR+','B',.F.,.T.

      DO BOXTD WITH 19,46,'PHAR. PAYABLE ('+AEACURR+') :'+TRANS(PTOTL,'#,###,###'),'PHAR. PAYABLE ('+AEACURR+') :'+TRANS(PTOTL,'##,###.##'),'GR+','B',.F.,.T.
      DO BOXTD WITH 22,46,'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'#,###,###'),'TOTAL PAYABLE ('+AEACURR+') :'+TRANS(TOTL,'##,###.##'),'GR+','B',.F.,.T.
   ENDIF
   SET COLOR TO BG+/B
   @ 9,0 CLEA TO 18,79
   @ 20,0 CLEA TO 24,45
   DO BOX2 WITH 22,0,'Other Drugs or Disposable items :','YES','NO','gr+','r','W+','N',PL8,.F.,.t.
   if pl8=2
      anod=.f.
   endif
ENDDO
*Formatted by: Herman T Ver. 7.1  on December 4, 1995.
